#!/usr/bin/perl
#
# Copyright 2008-2010 Vadim Zhukov <persgray@gmail.com>
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY AGAVA COMPANY ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
# EVENT SHALL THE AGAVA COMPANY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# The views and conclusions contained in the software and documentation are
# those of the authors and should not be interpreted as representing official
# policies, either expressed or implied, of the AGAVA Company.

use bytes;
use strict;

use Cwd qw/realpath/;
use Errno qw/EAGAIN EINVAL ENOENT/;
use Fcntl qw/:mode/;
use File::Basename;
use Getopt::Std;
use MIME::Base64 qw/encode_base64/;
use POSIX qw/:sys_wait_h strftime/;
use RB::Dir;
use RB::Log;
use RB::Profile;
use RB::Remote;
use RB::Transfer;
use RB::Util;

# For Getopt::Std
our $VERSION = "3.0";
$Getopt::Std::STANDARD_HELP_VERSION = 1;

# For RB::Log
our $LOGPROGNAME = 'rb_restore';


#####################################################################
# Loading configuration
#

sub HELP_MESSAGE {
	print <<EOU;
Usage:
rb_restore [-nOqv] [-d dir] [-T mintime] browse profile host [module [item]]
rb_restore [-nOqv] [-d dir] info profile host [archive ...]
rb_restore [-nOqv] [-d dir] list profile host [archive ...]
rb_restore [-nOqv] [-d dir] [-T mintime] command [option=value ...] profile host
           [modules [item ...]]
    -d Specify directory where archives are kept (defaults to ~/dumps/rb)
    -n Test mode: print debugging information
    -O Show/use only successfully ended backups
    -q Print raw data, useful for scripts and wrappers
    -T Override "min_remote_time", specified in seconds; 0 disables pauses
    -v Verbose mode; overrides -q
    Command names are case-insensetive. Commands summary:
browse  Starts interactive session. Initial module/item can be specified.
info    Shows detailed information about specified archived items. Archive
        should be specified in "module/item/date" form.
list    List items stored for host and their dates. Options as follows:
          date  If given, just show items backed up at date specified.
put     Transfer archive to the host without restoring. Options as follows:
          as    User under which to put files (needs sudo rigts for agent).
          date  If not given, last backup date will be used.
          on    Specifies host[:dir] to put data on.
restore Restore files from host backup. Options are same as for "put":
show    Alias for "list"
    "modules" may be a single module name or a comma-separated list of names
of modules to list/put/restore only.
    Profile can be set as relative (to ~/.rb/) or absolute path.
    Items are Perl regular expressions actually, but forced to match the whole
    string ("^" at the start and "$" at the end of each "item" string).
EOU
}

unless (@ARGV) {
	HELP_MESSAGE;
	exit 0;
}

my (%CmdLineOptions, %SLCmdLineOptions);
getopts('d:nOqT:v', \%SLCmdLineOptions);

my $Command = lc(shift @ARGV);
errx (1, "Command was not specified") unless $Command;
$Command = 'list' if $Command eq 'show';
unless ($Command eq 'browse' or $Command eq 'list' or $Command eq 'put'
    or $Command eq 'restore' or $Command eq 'info') {
	errx(1, "Unknown command: $Command")
}

# Removes command parameters from given arrayref and return them as hash.
sub extractCommandParameters(\@) {
	my $source = shift;    # Arrayref, not array!
	my %params;
	while (@{$source}) {
		my $pos = index($source->[0], '=');
		last if $pos <= 0;    # Not a command parameter
		my $sp = shift @{$source};
		$params{substr($sp, 0, $pos)} = substr($sp, $pos+1);
	}
	return %params;
}
my %CommandParameters = extractCommandParameters(@ARGV);

my ($ProfilePath, $Host) = (shift @ARGV, lc(shift @ARGV));
errx (1, "Profile was not specified") unless $ProfilePath ne '';
errx (1, "Host was not specified") unless $Host ne '';

# Default is not defined either
$CmdLineOptions{'archive_dir'} = $SLCmdLineOptions{'d'};
$CmdLineOptions{'min_remote_time'} = $SLCmdLineOptions{'T'};

# And those should be changed only by request
if (exists $SLCmdLineOptions{'n'}) {
	$CmdLineOptions{'test_mode'} = 1;
}
if (exists $SLCmdLineOptions{'O'}) {
	$CmdLineOptions{'ok_only'} = 1;
}
if (exists $SLCmdLineOptions{'q'}) {
	$CmdLineOptions{'verbosity'} = 0;
	$CmdLineOptions{'quiet'} = 1;
}
if (exists $SLCmdLineOptions{'v'}) {
	$CmdLineOptions{'verbosity'} = 2;
	$CmdLineOptions{'quiet'} = 0;
}

# Read profile
if (substr($ProfilePath, 0, 1) ne '/') {
	# Relative path, assume "~/.rb/" prefix
	$ProfilePath = $ENV{'HOME'}.'/.rb/'.$ProfilePath;
}
our $Profile = RB::Profile->new($ProfilePath);
our $Config = $Profile->{'global'};

# Merge command-line options. Simple, isn't it? ;)
for my $o (keys %CmdLineOptions) {
	next unless defined $CmdLineOptions{$o};
	$Config->{$o} = $CmdLineOptions{$o};
}

# Do not glob() data from command line
unless (defined $CmdLineOptions{'archive_dir'}) {
	($Config->{'archive_dir'}) = (glob $Config->{'archive_dir'});
}
if ($Config->{'archive_dir'} eq '') {
	$Config->{'archive_dir'} = '.';
}

# Make sure verbosity is set, to avoid warnings
$Config->{'verbosity'} = 0 unless defined $Config->{'verbosity'};

# Set up list of modules to work on
# Do not clear @ARGV!
my %Modules;           # Keys are modules specified, values are just "true"
if ($Command eq 'browse') {
	if (scalar(@ARGV) > 1) {
		errx(1, '"browse" command allows only one initial item');
	}
	# WorkDir will be set up later
} elsif ($Command ne 'info' and defined(my $module = shift @ARGV)) {
	if (index($module, ',') >= 0) {
		if ($Command eq 'browse') {
			errx(1, '"browse" command do not allows multiple module names');
		}
		%Modules = map { ($_, 1) } (split (',', $module));
	} else {
		%Modules = ( $module => 1 );
	}
} else {
	# All items used by default
	%Modules = map { ($_, 1) } @{$Config->{'backup_modules'}};
}


# Setting up ssh(1)/scp(1) options
my @SshCmdBase = qw/ssh -o BatchMode=yes -o RhostsAuthentication=no/;
my @ScpCmdBase = @SshCmdBase;
$ScpCmdBase[0] = 'scp';
# NOTE: scp(1) forces you to use "user@host" scheme!
if ($Config->{'ssh_user'}) {
	push(@SshCmdBase, '-l', $Config->{'ssh_user'});
}
# Process intended to be fully automatical, so no tty allocation needed.
push(@SshCmdBase, '-T');
# Do not bother printing progress
push(@ScpCmdBase, '-q');
# Last but not least
if ($Config->{'ssh_Port'}) {
	push(@SshCmdBase, '-p', $Config->{'ssh_port'});
	push(@ScpCmdBase, '-P', $Config->{'ssh_port'});
}

my $HostPath = realpath($Config->{'archive_dir'}.'/'.$Host);
unless (-d $HostPath) {
	logIt(0, "ERROR: host $Host dumps directory $HostPath doesn't exist.");
	exit 2;
}

#####################################################################
# Let's begin
#

# "module" => { }
my (%ScanCacheAll, %ScanCacheOk);

# Should not be called with an unverified module name
sub makeSureModuleScanned($) {
	my $moduleName = shift;
	if (!exists $ScanCacheAll{$moduleName}) {
		my $moduleDir = $HostPath.'/'.$moduleName;
		my ($all, $ok) = scanBackupDir(
		    $moduleDir, $Profile->{$moduleName});

		return 0 unless (defined $all and defined $ok);

		$ScanCacheAll{$moduleName} = $all;
		$ScanCacheOk{$moduleName} = $ok;
	}
	return 1;
}

# Arguments:
#   $itemDates   - substructure
#   $desiredDate - latest date that backup should exist for in YYYYMMDD format
#
# Returns:
#   (sorted) list of backup dates. This list may contain more than one item
#   if increment backups were used. Empty list means no suitable backups found.
sub findBestBackupLine($$) {
	my ($item, $desiredDate) = (shift, shift);

	my @variants = sort { $a <=> $b }
	               grep { $_ <= $desiredDate }
	               keys %{$item};
	return () unless @variants;

	BACKUP_VARIANTS:
	while (@variants) {
		my $endDate = pop @variants;
		my @backupList = ($endDate);
		while ($item->{$backupList[0]}->increment_from ne '') {
			unless (exists
			    $item->{$item->{$backupList[0]}->increment_from}) {
				next BACKUP_VARIANTS;
			}
			unshift(@backupList, $item->{$backupList[0]});
		}
		return @backupList;
	}
	return ();
}


#######################################
# Here go CLI mode only commands and CLI-specific variables.
#
# All of them recieve current module name as first argument,
# other arguments follow. Returns error code (0 means "no error").

my $WorkDir;      # Initialized on entering "browse mode"
my $TermWidth;    # Column count, initialized and used only in "browse" mode

# NOTE: Returns '' on success, error message otherwise
sub changeWd($) {
	my $newDir = shift;
	return '' if $newDir eq '';
	if (substr($newDir, 0, 1) ne '/') {
		my $base = $WorkDir;
		$base .= '/' unless $WorkDir =~ m|/$|;
		$newDir = $base.$newDir;
	}
	my $fullNewDir = realpath($HostPath.$newDir);
	if (substr($fullNewDir, 0, length($HostPath)) ne $HostPath) {
		# We shouldn't go out of $HostPath
		return "Illegal directory";
	}
	chdir($fullNewDir) or return "$!";
	$WorkDir = substr($fullNewDir, length($HostPath));
	return '';
}

sub getModuleName(;$) {
	my $item = @_ ? shift : $WorkDir;
	$item =~ s|^/+|/|g;
	my $end = index($item, '/', 1);
	$end = length($item) if $end < 0;
	return lc substr($item, 1, $end - 1);
}

sub cmd_help(@) {
	print <<EOH;
Command Description
cd      Changes current working directory (module, item)
info    Reads information about archives there
list    Lists whole module contents
ls      ls(1) analog
put     Send backup archive on another host
pwd     Prints current working directory
restore Restores data from backup
EOH
}

sub cmd_pwd(@) {
	print "$WorkDir\n";
	return 0;
}

sub cmd_cd(@) {
	if (scalar(@_) != 1) {
		print STDERR "Too many arguments\n";
		return 1;
	}
	my $err = changeWd($_[0]);
	if ($err ne '') {
		print STDERR $err."\n";
		return 1;
	}
	return 0;
}

# Both those routines can call each other, so predeclare
sub listDir;
sub listItem;

sub listDir($$$$) {
	my ($dir, $cache, $recursive, $printHeader) =
	    (shift, shift, shift, shift);

	if ($recursive or $printHeader) {
		print "$dir:\n";
	}

	my $path = realpath($HostPath.$dir);
	if (substr($path, 0, length($HostPath)) ne $HostPath) {
		print STDERR "Skipped illegal directory: ${dir}\n";
		return EINVAL;
	}

	my $dh;
	unless (opendir($dh, $path)) {
		print STDERR "Cannot open directory: $!\n";
		return $!+0;
	}

	my $err = 0;
	my @recurseIn;
	while (my $f = readdir $dh) {
		next if $f eq '..' and $path eq $HostPath;    # Root directory
		my $itemPath = $dir.'/'.$f;
		my @stat = lstat $path.'/'.$f;
		$cache->{$itemPath} = { 'stat' => \@stat };
		if (S_ISDIR($stat[2])) {
			$err = listItem $itemPath, $cache;
			push(@recurseIn, $itemPath) if $recursive;
		} elsif (S_ISREG($stat[2]) and $f =~ /^([0-9]{8})(\..*)$/) {
			my $infoPath = $dir.'/'.$1.'.info';
			# Avoid duplicates
			next if exists $cache->{$infoPath} and
			    exists $cache->{$infoPath}->{'info'};
			$err = listItem $infoPath, $cache;
		}
		# Ignore garbage quietly
		last if $err;
	}
	closedir $dh;

	foreach my $d (@recurseIn) {
		listDir $d, $cache, $recursive;
	}
	return $err;
}

# Waits for path to a directory or an archive information file.
sub listItem($$$$) {
	my ($item, $cache, $recursive, $descend) =
	    (shift, shift, shift, shift);

	my $fullPath = $HostPath.$item;
	unless ($cache->{$item}) {
		$cache->{$item} = { };
	}
	unless ($cache->{$item}->{'stat'}) {
		$cache->{$item}->{'stat'} = [ lstat $fullPath ];
	}
	my $stat = $cache->{$item}->{'stat'};

	unless (S_ISDIR($stat->[2]) or S_ISREG($stat->[2])) {
		print STDERR "Not a file or directory, skipped: $item\n";
		return EINVAL;
	}

	my $base = basename($item);
	my $moduleName = getModuleName $item;
	if ($moduleName ne '' and
	    $base ne '.' and $base ne '..' and
	    ($moduleName eq 'global' or !exists $Profile->{$moduleName})) {
		if ($descend) {
			print STDERR "No module $moduleName here\n";
			return ENOENT;
		} else {
			# Ignore garbage quietly
			return 0;
		}
	}

	my $itemType = '---';
	my $itemName = $base;
	my $info = { };
	if (S_ISDIR($stat->[2])) {
		if ($descend) {
			return listDir($item, $cache, $recursive, $descend);
		}
		$itemType = 'd--';
	} elsif ($moduleName ne '') {
		$info = $cache->{$item}->{'info'};
		if (!defined $info) {
			$info = processArchiveInfo($fullPath,
			    $Profile->{$moduleName});
			$cache->{$item}->{'info'} = $info;
		}
		unless (defined $info->{'type'}) {
			$info->{'type'} =
			    $Profile->{$moduleName}->{'what'};
		}
		unless (defined $info->{'format'}) {
			$info->{'format'} =
			    $Profile->{$moduleName}->{'archive_format'};
		}
		unless (defined $info->{'compressed'}) {
			$info->{'compressed'} =
			    $Profile->{$moduleName}->{'compress'};
		}
		unless (defined $info->{'extension'}) {
			$info->{'extension'} = constructArchiveExt(
			    $info->{'type'},
			    $info->{'format'},
			    $info->{'compressed'});
		}

		$itemName = substr($base, 0, -5).$info->{'extension'};
		$itemType = substr($info->{'type'}, 0, 1).
		    substr($info->{'format'}, 0, 1).
		    ($info->{'compressed'} ? 'c' : '-');
	} elsif ($descend) {
		# Fail items specified on command line
		print STDERR "Incorrect path: $item\n";
		return EINVAL;
	} else {
		return 0;
	}
	unless (defined $info->{'begin'}) {
		$info->{'begin'} = strftime('%Y-%m-%d %H:%M:%S',
		    localtime $stat->[9]);
	}
	unless (defined $info->{'exit_code'}) {
		# Optimistic, yeah
		$info->{'exit_code'} = 0;
	}

	printf "%s % 3d % 4s % 19s %s\n",
	    $itemType,
	    $info->{'exit_code'},
	    calcHumanSize($stat->[7]),
	    $info->{'begin'},
	    $itemName;
	return 0;
}

sub cmd_ls(@) {
	my @items;
	if (@_) {
		foreach my $item (@_) {
			my $itemPath;
			if (substr($item, 0, 1) eq '/') {
				$itemPath = $HostPath.$item;
			} else {
				$itemPath = $WorkDir.'/'.$item;
			}
			push(@items, $item);
		}
	} else {
		@items = '.';
	}

	print STDERR "ITEMS: ".join(', ', @items)."\n"
	    if $Config->{'test_mode'};
	my $err = 0;
	my %cache;
	foreach my $item (@items) {
		# Convert all relative references at top of item path
		if ($item =~ m|^\.(/.*)?$|) {
			$item = $WorkDir.$1;
		} elsif ($item =~ m|^\.\.(/.*)?$|) {
			if ($WorkDir eq '/') {
				$item = $WorkDir.$1;
			} else {
				$item = dirname($WorkDir).$1;
			}
		} elsif (substr($item, 0, 1) ne '/') {
			# Relative path too
			$item = $WorkDir.'/'.$item;
		}
		my $base = basename($item);
		if (!exists $cache{$item} and $base =~ /^[0-9]{8}$/) {
			my @stat = lstat $HostPath.$item;
			if (@stat) {
				$cache{$item} = { 'stat' => \@stat };
			} else {
				$item .= '.info';
			}
		}
		my $e = listItem($item, \%cache, 0, 1);
		$err = $e if $e;
	}
	return $err;
}

=head3 CMT
sub cmd_ls {
	# Set up default options
	my ($blockSize, $listDirs, $mode, $showTime, $sortBy, $sortDir) =
	    (($ENV{'BLOCKSIZE'} || 512), 1, 'multiCol', 'modified', 'name', 1);
	# Other options, unset by default
	my ($listDirs, $recursive, $sizeUnit, $showDirSign, $showFullTime,
	    $showSize);

	my @optBlocks;
	while (@_ and substr($_[0], 0, 1) eq '-') {
		push(@optBlocks, substr(shift(@_), 1));
	}
	print STDERR "OPTBLOCKS: ".join(' ', @optBlocks)."\n"
	    if $Config->{'test_mode'};

	LS_READ_OPTIONS_LOOP:
	while (@_) {
		last if substr($_[0], 0, 1) ne '-';
		my $optBlock = shift @_;
		if (length($optBlock) == 0) {
			print STDERR
			    "Error in command line: empty options block\n";
			return 1;
		}
		while (length($optBlock) > 0) {
			my $opt = substr($optBlock, 0, 1);
# We support following ls(1) parameters: 1CdFfghklmnpqRrSsTtux
# Some of the parameters are not fully supported, though.
			if ($opt eq '1') {
				$mode = 'single';
			} elsif ($opt eq 'C') {
				$mode = 'multiCol';
			} elsif ($opt eq 'c') {
				$showTime = 'statusModified';
			} elsif ($opt eq 'd') {
				$listDirs = 0;
			} elsif ($opt eq 'F' or $opt eq 'p') {
				$showDirSign = 1;
			} elsif ($opt eq 'f') {
				$sortBy => '';
			} elsif ($opt eq 'g' or $opt eq 'l' or $opt eq 'n') {
				$mode = 'long';
				$showSize = 1;
				$sizeUnit ||= 'bytes';
			} elsif ($opt eq 'h') {
				$sizeUnit = 'human';
			} elsif ($opt eq 'k') {
				$blockSize = '1k';
			} elsif ($opt eq 'm') {
				$mode = 'stream';
			} elsif ($opt eq 'q') {
				# Do nothing, it's default
			} elsif ($opt eq 'R') {
				$recursive = 1;
			} elsif ($opt eq 'r') {
				$sortDir = -1;
			} elsif ($opt eq 'S') {
				$sortBy = 'size';
			} elsif ($opt eq 's') {
				$showSize = 1;
				$sizeUnit ||= 'blocks';
			} elsif ($opt eq 'T') {
				$showFullTime = 1;
			} elsif ($opt eq 't') {
				$sortBy = 'modified';
			} elsif ($opt eq 'u') {
				$sortBy = 'lastAccessed';
			} elsif ($opt eq 'x') {
				$mode = 'multiRow';
			} elsif ($opt eq '-') {
				last LS_READ_OPTIONS_LOOP;
			} else {
				print STDERR "Unknown option \"$opt\"\n";
				return 1;
			}
		}
	}
	if (defined $sizeUnit) {
		if ($sizeUnit =~ /^([0-9]+)(k|m|g|t|e)?$/i) {
			$sizeUnit = $1 * calcFileSizeMultiplier($2 || 'k');
# 			Do we need this restriction?
# 			if ($sizeUnit < 512) {
# 				print STDERR "Minimum blocksize is 512\n";
# 				$sizeUnit = 512;
# 			}
			if ($sizeUnit <= 0) {
				print STDERR
				    "Minimum blocksize is 1, reset to 512\n";
				$sizeUnit = 512;
			}
		} else {
			print STDERR
			    "Unknown blocksize ${sizeUnit}, reset to 512\n";
			$sizeUnit = 512;
		}
	}

	my $longTimeFormat;
	if ($mode eq 'long') {
		if ($showFullTime) {
			$longTimeFormat = '%b %e %H:%M:%S %Y';
		} else {
			$longTimeFormat = '%b %e %H:%M';
		}
	}

	sub sortDirItems {
		my $itemsInfo = shift;
		if ($sortBy eq '') {
			return @_;
		} elsif ($sortBy eq 'name') {
			return sort { ($a cmp $b) * $sortDir } @_;
		} elsif ($sortBy eq 'size') {
			return sort { ($b <=> $a) * $sortDir }
				map { $itemsInfo->{$_}->[7] } @_;
		} elsif ($sortBy eq 'modified') {
			return sort { ($b <=> $a) * $sortDir }
				map { $itemsInfo->{$_}->[9] } @_;
		} elsif ($sortBy eq 'lastAccessed') {
			return sort { ($b <=> $a) * $sortDir }
				map { $itemsInfo->{$_}->[8] } @_;
		}
		die "Unknown sort method ${$sortBy}";
	}

	sub convertDirItemSize {
		my $size = $_[0];
		# $sizeUnit will be defined always for us
		if ($sizeUnit eq 'bytes') {
			return $size;
		} elsif ($sizeUnit eq 'human') {
			return calcHumanSize($size);
		} else {
			my $res = $size / $sizeUnit;
			$res++ if $size % $sizeUnit != 0;
			return $res;
		}
	}

	sub printDirItem_simple {
		my ($lineSep, $itemName, $itemInfo, $itemSizeFieldSize) =
		    (shift, shift, shift, shift);
		if (defined $itemInfo) {
			printf "% ${itemSizeFieldSize}d %s",
			    $itemInfo->[7],
			    "${itemName}${lineSep}";
		} else {
			print "${itemName}${lineSep}";
		}
	}
	sub printDirItem_single {
		printDirItem_simple("\n", @_);
	}
	sub printDirItem_stream {
		printDirItem_simple(", ", @_);
	}
	sub printDirItem_long {
		my ($itemName, $itemInfo, $itemSizeFieldSize) =
		    (shift, shift, shift);
		my $type = (S_ISDIR($itemInfo->[2]) ? 'd' : '-');
		my $t;
		if ($showTime eq 'lastAccessed') {
			$t = $itemInfo->[8];
		} elsif ($showTime eq 'modified') {
			$t = $itemInfo->[9];
		} elsif ($showTime eq 'statusModified') {
			$t = $itemInfo->[10];
		} else {
			die "Internal error: unknown time \"${showTime}\"";
		}
		printf "%s %s % ${itemSizeFieldSize}d %s\n",
		    $type,
		    strftime($longTimeFormat, localtime($t)),
		    $itemInfo->[7],
		    $itemName;
	}

	sub printDirItem_multiCol {
		my ($itemName, $itemInfo, $itemSizeFieldSize) =
		    (shift, shift, shift);
		printDirItem_single($itemName, $itemInfo, $itemSizeFieldSize);
	}

	sub printDirItem_multiRow {
		my ($itemName, $itemInfo, $itemSizeFieldSize) =
		    (shift, shift, shift);
		printDirItem_stream($itemName, $itemInfo, $itemSizeFieldSize);
	}

	# Call apporiate function
	my $printFunc = \&{"printDirItem_".$mode};
	print STDERR "ITEM PRINTER: printDirItem_${mode}\n"
	    if $Config->{'test_mode'};

	my @dirs;
	if (@_) {
		foreach my $item (@_) {
			my $itemPath;
			if (substr($item, 0, 1) eq '/') {
				$itemPath = $HostPath.$item;
			} else {
				$itemPath = $WorkDir.'/'.$item;
			}
		}
	} else {
		@dirs = ($WorkDir);
	}

	# Some internal flags, to avoid much calculations
	my $printDirHeader = (scalar(@dirs) > 1 or $recursive);
	my $readInfo = $showSize or ($sortBy ne '' and $sortBy ne 'name');
	my $workDirLen  = length($WorkDir);    # Cache
	my $hostDirLen  = length($HostPath);    # Cache
	print STDERR "DIRS: ".join(', ', @dirs)."\n"
	    if $Config->{'test_mode'};
	while (@dirs) {
		my $dir = shift @dirs;
		print STDERR "STEPPING in $dir\n" if $Config->{'test_mode'};
		my ($dirPath, $moduleName);
		if (substr($dir, 0, 1) eq '/') {
			$dirPath = realpath($HostPath.$dir);
		} else {
			$dirPath = realpath($HostPath.$WorkDir.'/'.$dir);
		}
		if (substr($dirPath, 0, length($HostPath)) ne $HostPath) {
			print STDERR "Skipped illegal directory: ${dir}\n";
			next;
		}
		print STDERR "FULL PATH: $dirPath\n" if $Config->{'test_mode'};

		$dirPath =~ m|^/([^/]+)/|;
# 		my $moduleName = $1;
# 		if ($moduleName ne '') {
# 			makeSureModuleScanned($moduleName);
# 		}

		unless (opendir(LSDIR, $dirPath)) {
			print STDERR "Cannot open directory $dir: $!\n";
			next
		}

		my (@dirItems, @subDirs, %itemsInfo);
		my $maxItemSize = 0;    # Used for justifiying size column
		my $maxItemLen  = 0;
		my $sumItemSize = 0;
		while (my $dirItem = readdir LSDIR) {
# 			print STDERR "ITEM: $dirItem\n"
# 			    if $Config->{'test_mode'};
			next if $dirItem eq '.' or $dirItem eq '..';
			my $dirItemPath = realpath($dirPath.'/'.$dirItem);
# 			print STDERR "ITEM PATH: $dirItemPath\n"
# 			    if $Config->{'test_mode'};
			next if substr($dirItemPath, 0, $hostDirLen)
			    ne $HostPath;
# 			print STDERR "ITEM PATH VALIDATED\n"
# 			    if $Config->{'test_mode'};

			my $isDir;
			if ($readInfo) {
				my @stat = stat($dirItemPath);
				$stat[7] = convertDirItemSize $stat[7];
				$maxItemSize = $stat[7]
				    if $stat[7] > $maxItemSize;
				$sumItemSize += $stat[7];
				$itemsInfo{$dirItem} = \@stat;
				$isDir = S_ISDIR($stat[2]);
			}
			if ($recursive) {
				$isDir = -d $dirItemPath unless defined $isDir;
				if ($isDir) {
					if (substr($dirItemPath, 0, $workDirLen)
					    eq $WorkDir) {
						# "/" at the start of path
						# is removed
						$dirItemPath = substr(
						    $dirItemPath,
						    $workDirLen+1);
					} else {
						# "/" at the start of path
						# is retained
						$dirItemPath = substr(
						    $dirItemPath, $hostDirLen);
					}
					push(@subDirs, $dirItemPath);
				}
			}

			my $itemLen = length($dirItem);
			$maxItemLen = $itemLen if $itemLen > $maxItemLen;
			push(@dirItems, $dirItem);
		}
		closedir LSDIR;
		my $itemSizeFieldSize = length($maxItemSize);

		# If recursive is not set, @subDirs will be empty
		if (@subDirs) {
			unshift(@dirs, sortDirItems(@subDirs));
		}

		if ($printDirHeader) {
			print "${dir}:\nTotal: ${sumItemSize}\n";
		}
		my $lineSep = ($mode eq 'stream' ? "," : "\n");
		foreach my $item (sortDirItems(\%itemsInfo, @dirItems)) {
# 			print STDERR "PRINTING ITEM $item\n"
# 			    if $Config->{'test_mode'};
			&{$printFunc}($item, $itemsInfo{$item},
			    $itemSizeFieldSize);
		}
		if ($printDirHeader and @dirs) {
			print "\n";
		}
	}
}
=cut


#######################################
# "Main" actions, same as above rules apply

sub cmd_list(@) {
	my $moduleName = getModuleName;
	if ($moduleName eq '') {
		print STDERR "Please, specify module\n";
		return 1;
	}
	my $whichFilter = makeWhichFilter(@_);

	if (!makeSureModuleScanned($moduleName)) {
		print STDERR "Cannot read module $moduleName contents\n";
		return 1;
	}
	my ($all, $ok) = ($ScanCacheAll{$moduleName}, $ScanCacheOk{$moduleName});

	print "Showing backups for module ${moduleName}\n"
	    unless $Config->{'quiet'};
	printArchiveContents($all, $ok, $whichFilter);
	return 0;
}

# Arguments:
#   $destPath      - base path for restoring
#   $backupInfoSrc - archive information tree to look in
#   $module        - backup module (structure)
#   $itemName      - name of item to be backed up (when "separate_archives" set)
#   $cmdBase       - arrayref with restore command and some already initialized
#                    parameters
#
# Returns:
#   boolean (true if no error, false if error occured)
#
# Side effects:
#   sets $! on error
sub put_archive_local($$$$\@@) {
	my ($destPath, $backupInfoSrc, $moduleName, $itemName, $cmdBase) =
	    splice(@_, 0, 5);
	
	foreach my $date (@_) {
		my $archive = $backupInfoSrc->{$itemName}->{$date};
	
		# Create destination bath, if needed
		my $itemDestPath = dirname($destPath.'/'.$itemName);
		if (!-d $itemDestPath) {
			system(qw/install -d/, $itemDestPath);
			if ($? == -1) {
				logIt(0, "Error: cannot run install(1)".
				    " to create destination directory ".
				    "($itemDestPath): $!");
				return 0;
			} elsif (($? >> 8) != 0) {
				# Error message will be shown by
				# install(1).
				$! = EAGAIN;
				return 0;
			}
		}

		my $destFullPath = $destPath.'/';
		$destFullPath .= $itemName.'-' if $itemName ne '';
		$destFullPath .= $moduleName;

# XXX WTF?!
# 		my $plainPath = $archive->archivePath;
# 		$plainPath =~ s|/|_|g;
# 		$destFullPath .= '-'.$plainPath if $plainPath ne '';
		
		# Avoid overriding existing files
		my $suffix = '';
		while (-e $destFullPath.$suffix) {
			$suffix++;
		}
		$destFullPath .= $suffix;
	
		# Copy file
		system(@{$cmdBase},
		    $HostPath.$WorkDir.'/'.$archive->archivePath,
		    $destFullPath);
		if ($? == -1) {
			logIt(0, "Error: cannot copy archive: $!");
			return 0;
		} elsif (($? >> 8) != 0) {
			# Error message'll be shown by install(1)
			$! = EAGAIN;
			return 0;
		}
	}
	return 1;
}

# Arguments:
#   $destPath      - base path for restoring
#   $backupInfoSrc - archive information tree to look in
#   $module        - backup module (structure)
#   $itemName      - name of item to be backed up (when "separate_archives" set)
#
# Returns:
#   boolean (true if no error, false if error occured)
#
# Side effects:
#   sets $! on error
sub restore_archive_files_local($$$$@) {
	my ($destPath, $backupInfoSrc, $module, $itemName) = splice(@_, 0, 4);

	foreach my $date (@_) {
		my $archive = $module->{$itemName}->{$date};
		my @cmd = ('pax', '-rp');
		push(@cmd, '-z') if $archive->compressed;
		push(@cmd, '-f');
	
		my $pid = fork;
		unless (defined $pid) {
			logIt(0, "Cannot fork: $!");
			return 0;
		} elsif ($pid == 0) {
			chdir $destPath or die "Cannot change directory: $!";
			exec(@cmd, $HostPath.$WorkDir.'/'.
			    $archive->archivePath);
			die "Cannot exec: $!";
		}
		if (waitpid($pid, 0) == -1) {
			logIt(0, "Error: cannot extract"
			    ." archive for ".$itemName.": $!");
			return 0;
		} elsif (($? >> 8) != 0) {
			# Error message'll be shown by tar(1)
			$! = EAGAIN;
			return 0;
		}
	}
	return 1;
}

# Arguments:
#   $cmd - "put" or "restore"
#
# Returns:
#   boolean (true if no error, false if error occured)
sub put_or_restore($@) {
	my $cmd = shift;
	my $moduleName = getModuleName;
	if ($moduleName eq '') {
		logIt(0, "Module name not cannot be empty");
		$! = EINVAL;
		return 0;
	};
	my $module = $Profile->{$moduleName};

	# NOTE: will fail on profile "separate_archives" change
	if (!$module->{'separate_archives'} and @_) {
		logIt(0, "Cannot use item filter in \"$cmd\" command when ".
		    "\"separate_archives\" is not set");
		$! = EINVAL;
		return 0;
	}
	my $whichFilter = makeWhichFilter(@_);

	makeSureModuleScanned($moduleName) or return 0;
	my ($all, $ok) = ($ScanCacheAll{$moduleName},
	    $ScanCacheOk{$moduleName});
	my $backupInfoSrc = $Config->{'ok_only'} ? $ok : $all;
	unless (%{$backupInfoSrc}) {
		logIt(0, "No backups found");
		$! = ENOENT;
		return 0;
	}

	my $destHost = ($CommandParameters{'on'} ne '' ?
	    $CommandParameters{'on'} : $Host);
	my $destPath = $module->{'workdir'};
	if ($destHost =~ /^([a-z0-9]([a-z0-9-]*[a-z0-9])?(\.[a-z0-9]([a-z0-9-]*[a-z0-9])?)*)?:(.*)$/is) {
		$destHost = $1;
		$destPath = $5 if $5 ne '';
	}
	logIt(1, "Processing \"$cmd\" on $destHost (to $destPath)");

	my @filteredItemNames;    # Only used when "separate_archives" is on
	# NOTE: will fail on profile "separate_archives" change
	if ($module->{'separate_archives'}) {
		@filteredItemNames = grep { /^$whichFilter$/ }
		    keys %{$backupInfoSrc};
		unless (@filteredItemNames) {
			logIt(0, "No items matched filter");
			# This is not an error
			return 1;
		}
	} else {
		@filteredItemNames = ('');
	}

	my $date = $CommandParameters{'date'};
	if ($date eq '') {
		# Defaults to date of latest backup exists.
		# There is at least one backup, see check a bit above.
		my @dates = sort { $a <=> $b }
		    map { keys %{$backupInfoSrc->{$_}} }
		    @filteredItemNames;
		$date = pop @dates;
	}

	my %itemBackupLines;
	my $nexists = 0;
	foreach my $itemName (@filteredItemNames) {
		my @backupLine = findBestBackupLine(
		    $backupInfoSrc->{$itemName}, $date);
		unless (@backupLine) {
			logIt(0, "No backup found".
			    ($itemName eq '' ? '' : " for $itemName").
			    " on date $date");
		} elsif ($backupLine[$#backupLine] ne $date) {
			logIt(0, "No backup found".
			    ($itemName eq '' ? '' : " for $itemName").
			    " on date $date, but there is older backup".
			    " on date ".$backupLine[$#backupLine]);
		} else {
			$itemBackupLines{$itemName} = \@backupLine;
			$nexists++;
		}
	}
	unless ($nexists) {
		$! = ENOENT;
		return 0;
	}

	if ($destHost eq '' and $cmd eq 'put') {
		my @cmdBase = ('install');
		if ($CommandParameters{'as'} ne '') {
			$CommandParameters{'as'} =~ /^([^:]*)(:(.*))$/s;
			push(@cmdBase, '-o', $1) if $1 ne '';
			push(@cmdBase, '-g', $3) if $3 ne '';
			push(@cmdBase, '-m', ($3 ne '') ? '0640' : '0600');
		} else {
			push(@cmdBase, '-m', '0600');
		}
		foreach my $itemName (keys %itemBackupLines) {
			return 0 unless put_archive_local($destPath,
			    $backupInfoSrc, $module, $itemName,
			    @cmdBase, @{$itemBackupLines{$itemName}});
		}
		return 1;
	} elsif ($destHost eq '' and $cmd eq 'restore') {
		# Yes, it's better to test $destHost once, but code has
		# enough indentation levels already. :)
		if ($module->what ne 'files') {
			print STDERR "Sorry, only local restoring of files is ".
			    "supported\n";
			return 0;
		}

		foreach my $itemName (keys %itemBackupLines) {
			# TODO: Clean up files got removed between dumps
			logIt(1, "Extracting locally item $itemName");
			return 0 unless restore_archive_files_local($destPath,
			    $backupInfoSrc, $module, $itemName,
			    @{$itemBackupLines{$itemName}});
		}
		return 1;
	}

	my $separator = generateSeparator;

	checkAgent($Host) or return 2;
	# NOTE: following will fail on profile change
	my ($agentPid, $xxx, $sshWrite) =
	    openAgentConn($Host, 0, 1, $cmd);
	return 0 unless defined $agentPid;

	syswrite($sshWrite, join('',
	    map { encodeHeader($_, $module->{$_}) }
	    grep { $_ ne 'which' and $_ ne 'workdir' }
	    keys %{$module}).
	    encodeHeader('module_name', $moduleName).
	    encodeHeader('workdir', $destPath).
	    encodeHeader('buffer_size', bufferSize).
	    encodeHeader('date', $date).
	    encodeHeader('separator', $separator))
	    or return 0;
	if ($CommandParameters{'as'} ne '') {
		syswrite($sshWrite,
		    encodeHeader('restore_as', $CommandParameters{'as'}))
		    or return 0;
	}
	syswrite($sshWrite, endHeaders) or return 0;

	# Send archives date by date, item by item
	my $sentOK = 1;
	PUT_OR_RESTORE_ITEMS:
	foreach my $itemName (keys %itemBackupLines) {
		foreach my $date (@{$itemBackupLines{$itemName}}) {
			my $archive = $backupInfoSrc->{$itemName}->{$date};
			my $srcPath = $archive->archivePath;
			unless (open(PUTSRC, '<', $srcPath)) {
				logIt(0, "Error: cannot open $srcPath for ".
				    "\"$cmd\": $!");
				$sentOK = 0;
				last PUT_OR_RESTORE_ITEMS;
			}
			if (scalar(@{$itemBackupLines{$itemName}}) > 1) {
				unless (syswrite($sshWrite,
				    encodeHeader('increment_restore', $itemName,
				    'from', $archive->increment_from))) {
					logIt(0, "Error writing header: $!");
					my $ec = $!+0;
					close PUTSRC;
					$sentOK = 0;
					$! = $ec if $ec;
					last PUT_OR_RESTORE_ITEMS;
				}
			}
			$sentOK = sendArchive(\*PUTSRC, $sshWrite,
			    $itemName, $separator) &&
			    (syswrite($sshWrite, endHeaders));
			my $ec = $!+0;
			close PUTSRC;
			$! = $ec if $ec;
			last PUT_OR_RESTORE_ITEMS unless $sentOK;
		}
	}

	my $ec = $!+0;
	close $sshWrite;
	waitpid($agentPid, WNOHANG);    # Avoid zombies
	$! = $ec if $ec;
	return $sentOK;
}

sub cmd_put(@) {
	undef $!;
	return $!+0 unless put_or_restore('put', @_);
	return 0;
}

sub cmd_restore(@) {
	undef $!;
	return $!+0 unless put_or_restore('restore', @_);
	return 0;
}

sub cmd_info(@) {
	unless (@_) {
		print STDERR "usage: info archive-name [...]\n";
		return 0;
	}
	my $module = $Profile->{getModuleName()};
	my $printHeader = scalar(@_) > 1;
	my $shown = 0;
	foreach my $item (@_) {
		print "${item}:\n" if $printHeader;
		if (substr($item, 0, 1) ne '/') {
			$item = $WorkDir.'/'.$item;
		}

		my $base = basename $item;
		if ($base !~ /^([0-9]{8})(\..*)?$/) {
			print STDERR "Illegal item name\n";
			next;
		}

		my $infoPath = substr($item, 0, length($item) - length($base)).
		    $1.'.info';
		$infoPath = realpath($HostPath.$infoPath);
		if (substr($infoPath, 0, length($HostPath)) ne $HostPath) {
			print STDERR "Illegal directory\n";
			next;
		}

		my ($info, $nfixed) = processArchiveInfo($infoPath, $module);
		# Error will be shown by processArchiveInfo(), so just "next"
		next unless defined $info;
		if ($nfixed) {
			print STDERR <<FIXWARN;
WARNING: Some values in archive information file were fixed on-the-fly, try to
run rb_fixinfo to make those fixes permanent. Remember that those fixes are done
automtically, so double-check the values you see.
FIXWARN
		}

		my $archivePath = substr($infoPath, 0, -5).$info->{'extension'};
		my @stat = stat $archivePath;
		unless (@stat) {
			print "WARNING: Cannot access archive data file ".
			    $archivePath.": $!\n";
			@stat = stat $infoPath;
		}

		print "Dumping begun at ".$info->{'begin'}."\n".
		    "Archive name: ".$1.$info->{'extension'}."\n".
		    "Archive format: ".$info->{'type'}.", ".$info->{'format'}.
		    ", ".($info->{'compressed'} eq 'no' ?
		    "uncompressed" : "compressed")."\n".
		    "Incremental from: ".$info->{'increment_from'}."\n".
		    "Dumping ended at ".$info->{'end'}." with code ".
		    $info->{'exit_code'}."\n";
	}
	return $shown ? 0 : EINVAL;
}

# Helper, handles the case "no such command"
sub execCommand(@) {
	my $cmd = lc(shift);
	if ($cmd eq 'show') {
		$cmd = 'list';
	} elsif ($cmd eq 'browse') {
		print STDERR "You're already in browsing mode!\n";
		return 1;
	} elsif ($cmd eq 'quit' or $cmd eq 'exit') {
		exit 0;
	}

	# We gurantee that there are no other subs beginning from "cmd_"
	my $cmdHandler = \&{'cmd_'.$cmd};
	my $errCode = eval { &{$cmdHandler}(@_) };
	if ($@) {
		print STDERR "Unknown command \"$cmd\" ($@)\n";
		return 1;
	}
	return $errCode;
}

my $ExitCode = 0;
openGlobalLog;

# Here we go
if ($Command eq 'browse') {
	require Term::ReadLine;
	require "sys/ioctl.ph";

	my $term = new Term::ReadLine 'Remote Backups Browser';

	$WorkDir = '/';
	my $err = changeWd($ARGV[0]);
	if ($err ne '') {
		print STDERR "Cannot change directory: $err\n".
		    "Root host directory will be used\n";
	}
	# Now we can do anything with @ARGV, it's not needed anymore

	# Detect terminal width
	$TermWidth = $ENV{'COLUMNS'};
	unless ($TermWidth) {
		require 'sys/ioctl.ph';
		my $termWindow = pack('S4', 0, 0, 0, 0);
		my $ioerr = ioctl(STDOUT, \&TIOCGWINSZ, $termWindow);
		($TermWidth) = unpack('x[S]Sx[S]x[S]', $termWindow)
		    if $ioerr eq '0 but true';
	}
	$TermWidth = 80 unless $TermWidth;    #Failsafe value

	# Input: command line
	# Output: list of stings: command at first, others follow.
	# Maybe it'll worth using Text::ParseWords instead?
	sub tokenize {
		my $line = shift;
		my @tokens;
		while ($line =~ /^\s*(("[^"]*"|'[^']*'|\S)+)/) {
			push(@tokens, substr($line, $-[1], $+[1]));
# 			print "CMD TOKEN FOUND: ".$tokens[$#tokens]."\n"
# 				if $Config->{'test_mode'};
# 			print "REMOVING FROM CMD LINE: \"".
# 			    substr($line, 0, $+[0]+1)."\"\n"
# 				if $Config->{'test_mode'};
			$line = substr($line, $+[0]+1);
		}
		return @tokens;
	}

	my $line;
	while (defined($line = $term->readline('rb '.$WorkDir.'> '))) {
# 		print STDERR "READLINE: ${line}\n" if $Config->{'test_mode'};
		my @cmdTokens = tokenize($line);
		next unless @cmdTokens and $cmdTokens[0] ne '';
		$term->addhistory($line);    # Add erroneous lines as well
		my $cmd = shift @cmdTokens;
		if ($cmd =~ /[^a-zA-Z]/) {
			# Prevent code injections. We guarantee that
			# there are no charecters in command names except
			# those from English alphabet.
			#
			# Error message same as in execCommand().
			print STDERR "Unknown command \"$cmd\"\n";
			next;
		}

# 		print STDERR "Executing command ${cmd}...\n"
# 		    if $Config->{'test_mode'};
		execCommand($cmd, @cmdTokens);
	}
	print "\n";
} elsif ($Command eq 'info') {
	# No modules dance
	$WorkDir = '/';
	$ExitCode = cmd_info(@ARGV);
} else {
	# Simple, isn't it? :)
	# We cannot use %Modules itself because order of keys in hash
	#  is not preserved.
	foreach my $moduleName (@{$Config->{'backup_modules'}}) {
		next unless $Modules{$moduleName};
		# We already checked $Command for validity, so it's safe
		$WorkDir = '/'.$moduleName;
		if ((my $rc = execCommand($Command, @ARGV)) > 0) {
			if ($ExitCode == 0 or $ExitCode > $rc) {
				$ExitCode = $rc;
			}
		}
	}
}

exit $ExitCode;
